home *** CD-ROM | disk | FTP | other *** search
/ The Glitch Apple Disk Collection / 2014.glitch.apple.collection.zip / indexed / 9B.DSK / OFF DUTY.V1.83.bas < prev    next >
BASIC Source File  |  2014-09-09  |  5KB  |  59 lines
  1. 0  REM    OFF DUTY.V1.83  (C) COPYRIGHT 1983 ELIZABETH LEVIN 
  2. 1  ONERR  GOTO 40000
  3. 100  HIMEM: 8192:V$ = "V1.83":S =  -16336:BLANK$ = "                                        "
  4. 130  DATA  32,74,255,173,48,192,136,208,5,206,1,3,240,9,202,208,245,174,0,3,76,5,3,32,63,255,96: FOR X = 770 TO 796: READ Y: POKE X,Y: NEXT 
  5. 140  DATA 47,63,76,95,127,191: DIM RIGHT(6): FOR X = 1 TO 6: READ RIGHT(X): NEXT 
  6. 190  DATA HAIR,CHIN,EYES,NOSE,MOUTH,"  DONE  ":NP = 6: DIM FACE$(NP): FOR X = 1 TO NP: READ FACE$(X): NEXT 
  7. 210 L$ = "HBCDFGWZLMNPRSTVKAE": DATA  A,E,I,O,U,EE,EA,OA,OO,AI,IA,IE,OU,AU,OI,OY,      E,ER,ELL,ICK,ING,COCK,WOOD,ORTH,MAN,SON,STEIN,SKY,BY,LY,MORE,: DIM LS$(16,2): FOR Y = 1 TO 2: FOR X = 1 TO 16: READ LS$(X,Y): NEXT : NEXT : DIM FACE(5): DATA 76,100,76,100,76,150,67,50   
  8. 250  DATA 76,75,85,25,90,75,85,25,76,100,113,100  : DATA  56,100,56,100,56,150,50,50 : DATA  56,75,63,25,67,75,63,25,56,100,85,100  : DATA 56,75,63,25,67,75,56,25,63,75,67,25,76,75,63,25
  9. 290  DATA  67,75,76,25,85,75,67,25,76,100,113,100: DATA   85,75,67,25,76,75,63,25,67,75,56,25,63,75,67,25,76,150,85,50,85,200: DIM N%(45,2): FOR X = 1 TO 45: FOR Y = 1 TO 2: READ N%(X,Y): NEXT : NEXT : HOME : GOSUB 30000: GOSUB 2000: VTAB 21: HTAB 1: INVERSE : PRINT BLANK$;BLANK$;: NORMAL 
  10. 500  REM 
  11. 510  FOR X = 113 TO 85  STEP  -1: POKE 768,X: POKE 769,4: CALL 770:SS =  PEEK(S): NEXT : INVERSE : VTAB 21: HTAB 1: PRINT BLANK$: GOSUB 2000: FOR PART = 1 TO 5:FACE(PART) = 0: NEXT :PART = 1: GOSUB 3000:ERR = 0: FOR PART = 1 TO 5: IF   NOT FACE(PART)  THEN ERR = 1
  12. 550  NEXT : IF ERR  THEN NAME$ = "IDENTITY UNKNOWN": GOTO 570
  13. 560 NAME$ =  MID$ (L$,FACE(1) +3,1) +"." + MID$ (L$,FACE(2),1) +LS$((FACE(3)),1) + MID$ (L$,FACE(4) +1,1) +LS$((FACE(5)),2)
  14. 570  VTAB 21: HTAB 1: INVERSE : PRINT BLANK$;: VTAB 21: HTAB 21 - LEN(NAME$)/2: PRINT NAME$: NORMAL : IF   NOT INST  THEN INST = 1
  15. 590  VTAB 23: HTAB 1: CALL  -958: NORMAL :F = 1:L = 20: GOSUB 8000: FOR X = 1 TO 27:SS =  PEEK(S): VTAB 23: HTAB X: PRINT " PRESS ";: INVERSE : PRINT "RETURN";: NORMAL : POKE 768,57 -X: POKE 769,5: CALL 770: FOR Y = 1 TO 10: NEXT : NEXT 
  16. 600  VTAB 24: HTAB 21: PRINT "OR TO STOP, PRESS ";: INVERSE : PRINT "S";
  17. 610  NORMAL : VTAB 1: GET ANS$: GOSUB 9000:: VTAB 23: HTAB 1: CALL  -958: IF ANS$ < >"S"  THEN F = 21:L = 45: GOSUB 8000: GOTO 500
  18. 660  HOME : NORMAL : PRINT : PRINT D$;"RUN HELLO,D1"
  19. 1000  REM 
  20. 1010 X = 70:Y = 0: IF FACE(P)  THEN  POKE 768,20: POKE 769,3: CALL 770
  21. 1020 L = PART%(P,FACE(P)) +L1: POKE 36352,L - INT(L/256) *256: POKE 36353, INT(L/256): POKE 36354,X -(X >255) *256: POKE 36355,X >255: POKE 36356,Y: CALL 36361: RETURN 
  22. 2000  REM 
  23. 2030  HCOLOR= 3: HPLOT 0,0: CALL 62454: RETURN 
  24. 3000  REM 
  25. 3005  VTAB 23: HTAB 1: CALL  -958: FOR X = 5 TO 1  STEP  -1: IF   NOT FACE(X)  THEN PART = X
  26. 3010  NEXT : IF   NOT INST  THEN H = 1: GOSUB 3450
  27. 3020  NORMAL : VTAB 24: HTAB 1: CALL  -958:H = 1: FOR X = 1 TO NP: HTAB H: PRINT FACE$(X);:H = H +6: NEXT 
  28. 3030  IF PART <1  THEN PART = NP
  29. 3040  IF PART >NP  THEN PART = 1
  30. 3050  FLASH : GOSUB 3300: NORMAL : GET ANS$: GOSUB 9000: IF ANS$ =  CHR$(21)  THEN  GOSUB 3300:PART = PART +1: GOTO 3030
  31. 3070  IF ANS$ =  CHR$(8)  THEN  GOSUB 3300:PART = PART -1: GOTO 3030
  32. 3080  IF ANS$ < > CHR$(13)  THEN  GOSUB 3400: GOTO 3030
  33. 3090  IF PART = NP  THEN  RETURN : REM 
  34. 3100  VTAB 23: HTAB 1: CALL  -958: FLASH : GOSUB 3300: NORMAL :FACE(PART) =  INT( RND(1) *MAX) +1
  35. 3110  IF FACE(PART) <1  THEN FACE(PART) = MAX
  36. 3120  IF FACE(PART) >MAX  THEN FACE(PART) = 1
  37. 3130  GOSUB 2000:P = PART: GOSUB 1000: GET ANS$: GOSUB 9000: IF ANS$ =  CHR$(21)  THEN FACE(PART) = FACE(PART) +1: GOTO 3110
  38. 3150  IF ANS$ =  CHR$(8)  THEN FACE(PART) = FACE(PART) -1: GOTO 3110
  39. 3160  IF ANS$ < > CHR$(13)  THEN  GOSUB 3400: GOTO 3110
  40. 3170  FOR P = 1 TO 5: IF P < >PART  THEN  GOSUB 1000
  41. 3180  NEXT :PART = NP: GOTO 3000
  42. 3300  REM 
  43. 3310 SS =  PEEK(S): POKE 768,RIGHT(PART): POKE 769,4: CALL 770: VTAB 24: HTAB (PART -1) *6 +1:H = 1 + PEEK(36): PRINT FACE$(PART);: VTAB 24: HTAB H: RETURN 
  44. 3400  IF KEY = 147  THEN 3470
  45. 3410  FOR X = 1 TO 50:SS =  PEEK(S): NEXT 
  46. 3450  VTAB 21: HTAB 2: NORMAL : PRINT  LEFT$(BLANK$,38);: VTAB 21: FLASH : HTAB 4: PRINT "ARROWS";: HTAB 22: PRINT "RETURN";: NORMAL 
  47. 3460  HTAB 10: PRINT " TO SEEK";: HTAB 28: PRINT " TO SELECT";:INST = 0: VTAB 1:SS =  PEEK(S)
  48. 3470  RETURN 
  49. 8000  REM 
  50. 8010  FOR X = F TO L: POKE 768,N%(X,1): POKE 769,N%(X,2): CALL 770: NEXT : RETURN 
  51. 9000  REM 
  52. 9010 KEY =  ASC(ANS$) +128: IF KEY = 147  THEN  POKE 770, SGN(64 - PEEK(770)) *64 + PEEK(770):S =   NOT  SGN(S) * -16336
  53. 9020  RETURN 
  54. 30000  REM 
  55. 30010 D$ =  CHR$(4): NORMAL :L1 = 24576: IF  PEEK(797) = 43  THEN 30050
  56. 30030  PRINT D$;"BLOAD CONSTRUCT": PRINT D$;"BLOAD PICTURES.";V$;",A";L1: POKE 797,43
  57. 30050 FILE$ = "SHAPE LENGTHS." +V$: PRINT D$;"OPEN ";FILE$;",D1": PRINT D$;"READ ";FILE$: INPUT MAX: DIM PART%(5,MAX): FOR X = 1 TO MAX: FOR PART = 1 TO 5: INPUT PART%(PART,X)
  58. 30130  NEXT : NEXT : PRINT D$;"CLOSE ";FILE$: PRINT : RETURN 
  59. 40000  RESUME